perm filename BIGGET.FAI[NEW,LCS]1 blob
sn#155902 filedate 1975-04-18 generic text, type T, neo UTF8
00100 TITLE BIGGET
00200 ENTRY BIGGET,MOVIT,SORT2,EXCH,EXTEN
00300 EXTERNAL .COMM.,XRN,KJY,PTR,NNP,MMV,RR4,AMOD
00400
00500 K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
00600 DEFINE FIXX(N)
00700 < JUMPGE N,.+5
00800 MOVNS N
00900 FIX N,233000
01000 MOVNS N
01100 CAIA
01200 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
01300
01400 ; SEE JJUST ---
01500
01600 BIGGET: 0 ;CALL BIGGET
01700 SETZ J, ; J=0
01800 SETZ K, ; K=0
01900 SETZ X, ; PTR IS LOC OF PWDS(1)
02000 MOVEI M,PTR ; DO 1 M=1,ITEM
02100 G1: AOJ X,
02200 MOVE L,(M) ; XRN IS LOC OF RN(1)
02300 FIXX(L)
02400 MOVEI R,XRN ;L=PWDS(M)
02500 ADDI R,(L)
02600 G9: MOVE A,2(R)
02700 CAMLE A,RR4+1
02800 JRST G2 ;9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
02900 CAMGE A,RR4 ;R4
03000 JRST G2
03100
03200 AOJ J,
03300 ; IN LIMITS?
03400 MOVEI A,MMV-1 ;J=J+1
03500 ADDI A,(J)
03600 MOVEI 0,(L)
03700 AOJ K, ;K=K+1
03800 MOVEI 1,NNP-1
03900 ADDI 1,(K) ;NP(K)=L
04000 MOVEM 0,(1)
04100 ADDI 0,3 ;N(J)=L+3
04200 MOVEM 0,(A)
04300 ; NP IS FOR USE IN JUSTIFY ROUTINE
04400 G2: MOVE RY,(R) ;2 IF(RY.LT.4)GO TO 1
04500 CAMGE RY,[=4.0]
04600 JRST GX
04700 CAMLE RY,[=7.0]
04800 JRST GX ;IF(RY.GT.7)GO TO 1
04900 ; TWO-ENDED ITEM?
05000 MOVE RZ,-1(R) ;RZ=RN(L)
05100 ; WD CNT
05200 CAMN RY,[=4.0] ;GO TO(4,5,6,7),IFIX(RY)-3
05300 JRST G4
05400 CAMN RY,[=5.0]
05500 JRST G5
05600 CAMN RY,[=6.0]
05700 JRST G6
05800 CAMG RZ,[=4.0] ;4 IF(RZ.GT.2)GO TO 5
05900 JRST G5 ; THERE IS A TRILL WIGGLE
06000 JRST GX ;GO TO 1 -- NO WIGGLE (P7≠0)
06100 G4: CAMG RZ,[=2.0] ;7 IF(RZ.GT.3)GO TO 5
06200 JRST GX
06300 JRST G5 ;GO TO 1
06400 G6: CAMGE RZ,[=8.0] ;6 IF(RZ.LT.8)GO TO 8
06500 JRST G8
06600 MOVE 1,=9(R) ;IF(RN(L+10).LT.30)GO TO 8
06700 CAMGE 1,[=30.0]
06800 JRST G8
06900 MOVE A,7(R) ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
07000 CAMLE A,RR4+1
07100 JRST G8
07200 CAMGE A,RR4
07300 JRST G8
07400 AOJ J,
07500 ; IN LIMITS?
07600 MOVEI A,MMV-1 ;J=J+1
07700 ADDI A,(J)
07800 MOVEI 0,(L) ;J=J+1
07900 ADDI 0,=8 ;N(J)=L+8
08000 MOVEM 0,(A)
08100 G8: CAMGE RZ,[=7.0] ;8 IF(RZ.LT.7)GO TO 5
08200 JRST G5
08300 MOVE A,6(R) ;IF(RN(L+7))GO TO G8B
08400 JUMPL A,G8B ; P7 IS NEG FOR TREMOLO
08500 MOVE A,7(R) ;IF(RN(L+8).NE.0)GO TO G8B
08600 JUMPN A,G8B
08700 CAMGE RZ,[=8.0]
08800 JRST G5 ;IF(RZ.LT.8)GO TO G5
08900 MOVE A,=9(R) ;IF(RN(L+10).EQ.0)GO TO G5
09000 JUMPE A,G5 ;PASSES NUMBER OVER BEAM.
09100 G8B: MOVE A,8(R)
09200 CAMLE A,RR4+1
09300 JRST G5
09400 CAMGE A,RR4 ;R4
09500 JRST G5
09600
09700 AOJ J, ;J=J+1
09800 ; IN LIMITS?
09900 MOVEI A,MMV-1 ;J=J+1
10000 ADDI A,(J)
10100 MOVEI 0,(L)
10200 ADDI 0,=9 ;IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
10300 MOVEM 0,(A) ;N(J)=L+9
10400 G5: MOVE A,5(R)
10500 CAMLE A,RR4+1
10600 JRST GX
10700 CAMGE A,RR4 ;R4
10800 JRST GX
10900
11000 AOJ J,
11100 ; IN LIMITS?
11200 MOVEI A,MMV-1 ;J=J+1
11300 ADDI A,(J)
11400 MOVEI 0,(L) ;5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
11500 ADDI 0,6 ;N(J)=L+6
11600 MOVEM 0,(A)
11700 GX: CAMGE X,RR4+4 ;1 CONTINUE
11800 AOJA M,G1 ;RR4+4 IS I (OR NUM OF ITEMS)
11900 MOVEM J,KJY+1
12000 MOVEM K,KJY
12100 JRA 16,(16)
12200
12300 ; SUBROUTINE MOVIT
12400 ; DIMENSION N(500)
12500 ; COMMON/XRN/RN(4000) /KJY/ DONT,J
12600 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
12700 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
12800 ; 1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
12900 MOVIT: 0 ;RDIS=(R9-R8)/(R5-R4)
13000 MOVE R,.COMM.+3
13100 FSBR R,.COMM.+2
13200 MOVE RY,RR4+1
13300 FSBR RY,RR4
13400 FDVR R,RY
13500 MOVEI L,MMV ; DO 1 K=1,J
13600 SETZ K,
13700 MOVE 0,.COMM.+3 ; SET UP R9
13800 M1: MOVE X,L ; L=N(K)
13900 MOVE A,(X)
14000 MOVEI R2,XRN ;RA=RN(L)
14100 ADDI R2,(A)
14200 MOVEI RZ,(R2)
14300 MOVE R2,-1(R2)
14400 CAMGE R2,RR4 ;IF(OUTLIM(R4,R5,RA))GO TO 1
14500 JRST MX
14600 CAMLE R2,RR4+1
14700 JRST MX
14800 JUMPE 0,M2 ;IF(R9.NE.0)RA=(RA-R4)*RDIS
14900 FSBR R2,RR4
15000 FMPR R2,R
15100 M2: FADR R2,.COMM.+2 ; RN(L)=R8+RA
15200 MOVEM R2,-1(RZ)
15300 MX: AOJ K, ;1 CONTINUE
15400 CAMGE K,KJY+1
15500 AOJA L,M1
15600 JRA 16,(16)
15700
15800 SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
15900 MOVEI 2,2 ;DIMENSION RPOS(2,200)
16000 S3: MOVE 6,2 ;(K=L HERE)
16100 SETO 11, ;L=2
16200 HRRZI 3,@(16) ;3 J=-1
16300 MOVE 4,2 ;RX=RPOS(1,L-1)
16400 SUBI 4,1 ;L-1
16500 IMULI 4,2
16600 ADDI 4,(3)
16700 MOVE 5,-2(4) ;RX
16800 S2: MOVE 7,6 ; DO 2 K=L,M
16900 ;; LSH 7,1 ;IF(RPOS(1,K).GE.RX)GO TO 2
17000 IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
17100 ADDI 7,(3)
17200 CAMG 5,-2(7)
17300 JRST S1 ; CONTINUE
17400 MOVE 5,-2(7) ; RX=RPOS(1,K)
17500 ;;C WHY WERE ALL THE RX'S JX ????? 9/6/73
17600 MOVE 11,6 ;J=K
17700 S1: CAMGE 6,@1(16) ;2 CONTINUE
17800 AOJA 6,S2
17900 JUMPL 11,S4 ;IF(J)GO TO 4
18000 MOVE 12,2 ;K=L-1
18100 SOS 12
18200 IMULI 12,2 ;(K*2)
18300 ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
18400 MOVE 10,-2(12)
18500 ;; LSH 11,1 ;MULTS BY 2 (LEFT SHIFT)
18600 IMULI 11,2
18700 ADD 11,3
18800 EXCH 10,-2(11)
18900 MOVEM 10,-2(12)
19000 MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
19100 EXCH 10,-1(11)
19200 MOVEM 10,-1(12)
19300 S4: CAMGE 2,@1(16) ;4 L=L+1
19400 AOJA 2,S3 ;IF(L.LE.M)GO TO 3
19500 JRA 16,2(16) ;END
19600
19700
19800 EXCH: 0 ; SUBROUTINE EXCH(X,Y)
19900 MOVE @(16)
20000 EXCH 0,@1(16)
20100 MOVEM 0,@(16)
20200 JRA 16,2(16)
20300
20400 EXTEN: 0 ;FUNCTION EXTEN(X)
20500 HRRM 16,.+2
20600 JSA 16,AMOD ;EXTEN=AMOD(X,1.)*10.
20700 JUMP @0
20800 JUMP [=1.0]
20900 FMPR [=10.0]
21000 JRA 16,1(16)
21100
21200 END